home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / bootstrap.c < prev    next >
C/C++ Source or Header  |  1993-06-27  |  7KB  |  283 lines
  1. /* ******************************************************************** */
  2. /*  bootstrap.c      Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Rig up the basic Metaclasses/Classes                                 */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: bootstrap.c,v 2.1 93/01/17 17:25:21 pab Exp $
  9.  *
  10.  * $Log:    bootstrap.c,v $
  11.  * Revision 2.1  93/01/17  17:25:21  pab
  12.  * 17 Jan 1993 The next generation...
  13.  * 
  14.  * Revision 1.9  1992/11/25  16:59:58  pab
  15.  * Version .8
  16.  *
  17.  * Revision 1.7  1992/08/06  18:08:10  pab
  18.  * I/C-function support
  19.  *
  20.  * Revision 1.6  1992/01/17  22:26:18  pab
  21.  * deleted redundant function
  22.  *
  23.  * Revision 1.5  1992/01/09  22:28:43  pab
  24.  * Fixed for low tag ints
  25.  *
  26.  * Revision 1.4  1991/12/22  15:13:50  pab
  27.  * Xmas revision
  28.  *
  29.  * Revision 1.3  1991/11/15  13:44:21  pab
  30.  * copyalloc rev 0.01
  31.  *
  32.  * Revision 1.2  1991/09/11  12:07:00  pab
  33.  * 11/9/91 First Alpha release of modified system
  34.  *
  35.  * Revision 1.1  1991/08/12  16:49:27  pab
  36.  * Initial revision
  37.  *
  38.  * Revision 1.2  1991/02/13  18:16:46  kjp
  39.  * Weak wrapper class + RCS log headers.
  40.  *
  41.  */
  42.  
  43. #define KJPDBG(x) 
  44.  
  45. /*
  46.  * Change Log:
  47.  *   Version 1, June 1989
  48.  */
  49.  
  50. #include <stdio.h>
  51. #include "funcalls.h"
  52. #include "defs.h"
  53. #include "structs.h"
  54. #include "global.h"
  55.  
  56. #include "bootstrap.h"
  57. #include "symboot.h"
  58. #include "allocate.h"
  59. #include "copy.h"
  60.  
  61. #include "slots.h"
  62. #include "ngenerics.h"
  63. #include "table.h"
  64. /*
  65.  
  66.  * Should maybe turn all the symbol and class structure mallocs
  67.  * into statics...
  68.  
  69.  */
  70.  
  71. extern LispObject Primitive_Class;
  72. extern LispObject Thread_Class;
  73. extern LispObject Method_Class;
  74.  
  75. /*
  76.  
  77.  * Special symbol initialisation...
  78.  
  79.  */
  80.  
  81. /* 
  82.  * 'Place marker' class initialisation.
  83.  * NB. Count must include superclasses...
  84.  */
  85. void gen_class_with_slots(LispObject *stacktop,
  86.               LispObject *obj,
  87.               int local_count)
  88. {
  89.   gen_class(stacktop,obj);
  90.   (*obj)->CLASS.local_count = allocate_integer(stacktop, local_count);
  91.  
  92. }
  93.  
  94. /* Also registers a new root */
  95.  
  96. void gen_class(LispObject *stackbase,
  97.            LispObject *obj)
  98. {
  99.   LispObject sym, xx;
  100.   LispObject *stacktop=stackbase+2;
  101.  
  102.   *obj = (LispObject) allocate_class(stacktop,NULL);
  103. }
  104.  
  105. void set_class_size(LispObject *stacktop, LispObject class, LispObject super, int size)
  106. {
  107.   LispObject sz;
  108.  
  109.   STACK_TMP(class);
  110.   sz=allocate_integer(stacktop, (super==NULL) ? size : intval(super->CLASS.local_count)+size);
  111.   UNSTACK_TMP(class);
  112.  
  113.   class->CLASS.local_count=sz;
  114.   
  115. }
  116.  
  117. /*
  118.  
  119.  * Set up all the provided classes + special symbols.
  120.  
  121.  */
  122.  
  123. void bootstrap(LispObject *stacktop)
  124. {
  125.   /* Reserve space for the classes... 
  126.      ... non garbage and easy for self reference */
  127.  
  128.   /* Root object and root class - self referential... */
  129.  
  130.   Object          = (LispObject) allocate_class(stacktop,NULL);
  131.   Standard_Class  = (LispObject) allocate_class(stacktop,NULL);
  132.  
  133.   add_root(&Object); add_root(&Standard_Class); 
  134.     
  135.   Symbol = (LispObject) allocate_class(stacktop,NULL);
  136.  
  137.   Null = (LispObject) allocate_class(stacktop,NULL);
  138.  
  139.   Cons = (LispObject) allocate_class(stacktop,NULL);
  140.  
  141.   Integer = (LispObject) allocate_class(stacktop,NULL);
  142.  
  143.   Vector = (LispObject) allocate_class(stacktop,NULL);
  144.   add_root(&Symbol);
  145.   add_root(&Null);
  146.   add_root(&Cons);
  147.   add_root(&Integer);
  148.   add_root(&Vector);
  149.   /* Get nil... */
  150.  
  151.   EUCALLSET_2(nil, Fn_cons, NULL,NULL);
  152.   lval_typeof(nil) = TYPE_NULL;
  153.   add_root(&nil);
  154.   /* Fill it later... */
  155.   
  156.   /* Symbols and objects needed during class gen */
  157. /**
  158.   lisptrue 
  159.     = (LispObject) system_static_malloc(sizeof(struct symbol_structure));
  160. **/
  161.   /* Self evaluating symbols and nil */
  162.  
  163.   (void) make_special_symbol(stacktop,&lisptrue,"t");
  164.   (void) make_special_symbol(stacktop,&unbound,"%_*unbound*_%");
  165.   add_root(&lisptrue);    
  166.   add_root(&unbound);
  167.  
  168.   /* Begin initialising... */
  169.   /* We need integers for this... */
  170.   allocate_static_integers(stacktop);
  171.     
  172.   gen_class(stacktop,&Primitive_Class);
  173.   add_root(&Primitive_Class);
  174.  
  175.   gen_class(stacktop,&Thread_Class);
  176.   add_root(&Thread_Class);
  177.  
  178.   /* The "place marker" classes */
  179.  
  180.   /* Metas */
  181.  
  182.   gen_class(stacktop,&Funcallable_Object_Class);
  183.   add_root(&Funcallable_Object_Class);
  184.   gen_class(stacktop,&Method_Class);
  185.   add_root(&Method_Class);
  186.   gen_class(stacktop,&Generic_Class);
  187.   add_root(&Generic_Class);
  188.   gen_class(stacktop,&Number);
  189.   add_root(&Number);
  190.   gen_class(stacktop,&Real);
  191.   add_root(&Real);
  192.   gen_class(stacktop,&Character);
  193.   add_root(&Character);
  194.   gen_class(stacktop,&String);
  195.   add_root(&String);
  196.   gen_class(stacktop,&Thread);
  197.   add_root(&Thread);
  198.   gen_class(stacktop,&Function);
  199.   add_root(&Function);
  200.  
  201.   gen_class(stacktop,&CFunction);
  202.   add_root(&CFunction);
  203.  
  204.   gen_class(stacktop,&IFunction);
  205.   add_root(&IFunction);
  206.  
  207.   gen_class(stacktop,&Continue);
  208.   add_root(&Continue);
  209.   gen_class(stacktop,&Generic);
  210.   add_root(&Generic);
  211.   gen_class(stacktop,&Method);
  212.   add_root(&Method);
  213.   gen_class(stacktop,&Table);
  214.   add_root(&Table);
  215.  
  216.   gen_class(stacktop,&Weak_Wrapper);
  217.   add_root(&Weak_Wrapper);
  218.   /* Do nil... */
  219.  
  220. #ifdef WITH_SMALL_CONSES
  221.   nil->CONS.car = nil;
  222.   nil->CONS.cdr = nil;
  223. #else
  224.   lval_classof(nil) = Null;
  225.   nil->CONS.car = nil;
  226.   nil->CONS.cdr = nil;
  227. #endif
  228.   { 
  229.     extern LispObject boot_thread;
  230.     lval_classof(boot_thread)=Thread;
  231.   }
  232.  
  233.   /* Set up class size hierarchy. 
  234.      Size _is_ important in this game.
  235.      It is poss. for extra classes to be 
  236.      inserted by init, but _no_ additional slots !*/
  237.   
  238.   set_class_size(stacktop,Object,NULL,0);
  239.   /* metaclasses...*/
  240.   set_class_size(stacktop,Standard_Class,Object,N_SLOTS_IN_CLASS);
  241.  
  242.   set_class_size(stacktop,Table,Object,N_SLOTS_IN_TABLE);
  243.   set_class_size(stacktop,Thread,Object,N_SLOTS_IN_THREAD);
  244.   set_class_size(stacktop,Generic,Object,N_SLOTS_IN_GENERIC);
  245.   set_class_size(stacktop,Method,Object,N_SLOTS_IN_METHOD);
  246.   
  247.   /* Characters */
  248.   allocate_static_chars(stacktop);
  249.  
  250.  
  251. }
  252.  
  253. void initialize_boot_classes(LispObject *stacktop)
  254. {
  255.   
  256.   make_module_entry(stacktop,"<object>",Object);
  257.   make_module_entry(stacktop,"<class>",Standard_Class);
  258.   make_module_entry(stacktop,"<primitive-class>",Primitive_Class);
  259.   make_module_entry(stacktop,"<thread-class>",Thread_Class);
  260.   make_module_entry(stacktop,"<funcallable-object-class>",Funcallable_Object_Class);
  261.   make_module_entry(stacktop,"<method-class>",Method_Class);
  262.   make_module_entry(stacktop,"<generic-class>",Generic_Class);
  263.   make_module_entry(stacktop,"<number>",Number);
  264.   make_module_entry(stacktop,"<double-float>",Real);
  265.   make_module_entry(stacktop,"<fixint>",Integer);
  266.   make_module_entry(stacktop,"<symbol>",Symbol);
  267.   make_module_entry(stacktop,"<null>",Null);
  268.   make_module_entry(stacktop,"<pair>",Cons);
  269.   make_module_entry(stacktop,"<character>",Character);
  270.   make_module_entry(stacktop,"<string>",String);
  271.   make_module_entry(stacktop,"<thread>",Thread);
  272.   make_module_entry(stacktop,"<function>",Function);
  273.   make_module_entry(stacktop,"<c-function>",CFunction);
  274.   make_module_entry(stacktop,"<i-function>",IFunction);
  275.   make_module_entry(stacktop,"<continuation>",Continue);
  276.   make_module_entry(stacktop,"<generic-function>",Generic);
  277.   make_module_entry(stacktop,"<method>",Method);
  278.   make_module_entry(stacktop,"<vector>",Vector);
  279.   make_module_entry(stacktop,"<table>",Table);
  280.   make_module_entry(stacktop,"<weak-wrapper>",Weak_Wrapper);
  281.  
  282. }
  283.